home *** CD-ROM | disk | FTP | other *** search
/ Enter 2004 January / enter-2004-01.iso / files / maxima-5.9.0.exe / {app} / share / maxima / 5.9.0 / src / displm.lisp < prev    next >
Encoding:
Text File  |  2003-02-09  |  6.0 KB  |  156 lines
  1. ;;; -*-  Mode: Lisp; Package: Maxima; Syntax: Common-Lisp; Base: 10 -*- ;;;;
  2. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  3. ;;;     The data in this file contains enhancments.                    ;;;;;
  4. ;;;                                                                    ;;;;;
  5. ;;;  Copyright (c) 1984,1987 by William Schelter,University of Texas   ;;;;;
  6. ;;;     All rights reserved                                            ;;;;;
  7. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  8. ;;;     (c) Copyright 1982 Massachusetts Institute of Technology         ;;;
  9. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  10.  
  11. (in-package "MAXIMA")
  12. (macsyma-module displm macro)
  13.  
  14. (declare-top
  15.  ;; evaluate for declarations
  16.  (SPECIAL
  17.    ^W               ;If T, then no output goes to the console.
  18.    ^R               ;If T, then output also goes to any
  19.                ;file opened by UWRITE.  People learning
  20.                ;Lisp: there are better ways of doing IO
  21.                ;than this -- don't copy this scheme.
  22.    SMART-TTY           ;LOADER sets this flag.  If T, then
  23.                ;then this console can do cursor movement
  24.                ;and equations can be drawn in two dimensions.
  25.    RUBOUT-TTY           ;If T, then console either selectively erasable
  26.                ;or is a glass tty.  Characters can be rubbed
  27.                ;out in either case.
  28.    SCROLLP           ;If T, then the console is scrolling.
  29.                ;This should almost always be equal to
  30.                ;(NOT SMART-TTY) except when somebody has
  31.                ;done :TCTYP SCROLL on a display console.
  32.                ;This is the %TSROL bit of the TTYSTS word.
  33.  
  34.    LINEL           ;Width of screen.
  35.    TTYHEIGHT           ;Height of screen.
  36.  
  37.    WIDTH HEIGHT DEPTH MAXHT MAXDP LEVEL SIZE LOP ROP BREAK RIGHT
  38.    BKPT BKPTWD BKPTHT BKPTDP BKPTLEVEL BKPTOUT LINES 
  39.    OLDROW OLDCOL DISPLAY-FILE IN-P
  40.    MOREMSG MOREFLUSH MORE-^W MRATP $ALIASES ALIASLIST)
  41.  
  42. (FIXNUM WIDTH HEIGHT DEPTH MAXHT MAXDP LEVEL SIZE RIGHT 
  43.     BKPTWD BKPTHT BKPTDP BKPTLEVEL BKPTOUT
  44.     LINEL TTYHEIGHT OLDROW OLDCOL)
  45.  
  46. (NOTYPE (TYO* FIXNUM) (SETCURSORPOS FIXNUM FIXNUM))
  47.  
  48. (*EXPR +TYO SETCURSORPOS MTERPRI FORCE-OUTPUT LINEAR-DISPLA
  49.        TTYINTSON TTYINTSOFF MORE-FUN GETOP
  50.        LBP RBP NFORMAT FULLSTRIP1 MAKSTRING $LISTP)
  51.  
  52. ;; stuff other packages might want to reference selectively.
  53. (*expr displa dimension checkrat checkbreak)
  54. ;; looks like missplaced declarations to me.
  55. ;; does DISPLA really call $integrate?
  56. (*lexpr $box $diff $expand $factor $integrate $multthru $ratsimp)
  57. )
  58.  
  59. ;;; macros for the DISPLA package.
  60.  
  61. (DEFMACRO TABLEN () #-(or Franz CL) (STATUS TABSIZE) #+(or Franz CL) 8)
  62.  
  63. ;; macros to handle systemic array differences.
  64. ;; NIL has various types of arrays, and supports *ARRAY in compatibility,
  65. ;; but might as well use the natural thing here, a vector.
  66.  
  67. (DEFMACRO MAKE-LINEARRAY (SIZE)
  68.   #+(or Maclisp Franz) `(*ARRAY NIL T ,SIZE)
  69.   #+(or cl NIL) `(make-array ,size :initial-element nil)
  70.   )
  71.  
  72. (DEFMACRO SET-LINEARRAY (I X)
  73.   #+(or Maclisp Franz) `(STORE (ARRAYCALL T LINEARRAY ,I) ,X)
  74.   #+(or cl NIL) `(SETF (SVREF LINEARRAY ,I) ,X)
  75.   )
  76.  
  77. (DEFMACRO LINEARRAY (J)
  78.   #+cl `(AREF LINEARRAY ,J)
  79.   #+(or Maclisp Franz) `(ARRAYCALL T LINEARRAY ,J)
  80.   #+NIL `(SVREF LINEARRAY ,J)
  81.   )
  82.  
  83. (DEFMACRO LINEARRAY-DIM ()
  84.   #+(OR  MACLISP FRANZ) '(ARRAY-DIMENSION-N 1 LINEARRAY)
  85.   #+(or cl NIL) '(LENGTH (the vector LINEARRAY)))
  86.  
  87. (DEFMACRO CLEAR-LINEARRAY ()
  88.   #+(OR  MACLISP FRANZ) '(FILLARRAY LINEARRAY '(NIL))
  89.   #+(or cl NIL) '(FILL LINEARRAY NIL))
  90.  
  91. ;; (PUSH-STRING "foo" RESULT) --> (SETQ RESULT (APPEND '(#/o #/o #/f) RESULT))
  92. ;; CHECK-ARG temporarily missing from Multics.
  93.  
  94. (DEFMACRO PUSH-STRING (STRING SYMBOL)
  95.   #-(or Franz Multics) (CHECK-ARG STRING STRINGP "a string")
  96.   #-(or Franz Multics) (CHECK-ARG SYMBOL SYMBOLP "a symbol")
  97.   ;`(SETQ ,SYMBOL (APPEND ',(NREVERSE (EXPLODEN STRING)) ,SYMBOL))
  98.   ;The string is usually short.  Do it out...
  99.   `(setq ,symbol (list* ,@(nreverse (exploden string)) ,symbol))
  100.   )
  101.  
  102. ;; Macros for setting up dispatch table.
  103. ;; Don't call this DEF-DISPLA, since it shouldn't be annotated by
  104. ;; TAGS and @.  Syntax is:
  105. ;; (DISPLA-DEF [<operator>] [<dissym> | <l-dissym> <r-dissym>] [<lbp>] [<rbp>])
  106. ;; If only one integer appears in the form, then it is taken to be an RBP.
  107.  
  108. ;; This should be modified to use GJC's dispatch scheme where the subr
  109. ;; object is placed directly on the symbol's property list and subrcall
  110. ;; is used when dispatching.
  111.  
  112. (DEFMACRO DISPLA-DEF (OPERATOR DIM-FUNCTION &REST REST
  113.                    &AUX L-DISSYM R-DISSYM LBP RBP)
  114.   (DOLIST (X REST)
  115.     (COND ((STRINGP X)
  116.        (IF L-DISSYM (SETQ R-DISSYM X) (SETQ L-DISSYM X)))
  117.       ((INTEGERP X)
  118.        (IF RBP (SETQ LBP RBP))
  119.        (SETQ RBP X))
  120.       (T (MAXIMA-ERROR "Random object in DISPLA-DEF form" X))))
  121.   (IF L-DISSYM
  122.       (SETQ L-DISSYM
  123.         (IF R-DISSYM
  124.         (CONS (EXPLODEN L-DISSYM) (EXPLODEN R-DISSYM))
  125.         (EXPLODEN L-DISSYM))))
  126.   `(PROGN 
  127.       (DEFPROP ,OPERATOR ,DIM-FUNCTION DIMENSION)
  128.       ,(IF L-DISSYM  `(DEFPROP ,OPERATOR ,L-DISSYM DISSYM))
  129.       ,(IF LBP       `(DEFPROP ,OPERATOR ,LBP LBP))
  130.       ,(IF RBP       `(DEFPROP ,OPERATOR ,RBP RBP))))
  131.  
  132. ;; Why must interrupts be turned off?  Is there some problem with keeping
  133. ;; internal state consistent?  If this is the case, then scheduling should be
  134. ;; inhibited on the Lispm as well.
  135. ;; Who's comment? It is obvious that there is this global array LINEARRAY,
  136. ;; which gets bashed during DISPLA. Seems like the best thing to do is
  137. ;; to use AREF and ASET on a special variable bound to an array pointer.
  138. ;; If a reentrant call to DISPLA is made, then just bind this variable
  139. ;; to a new array. -GJC
  140. ;; So it was written, so it shall be done, eventually.
  141. ;; Ah, got around to it... 9:32pm  Wednesday, 2 December 1981
  142.  
  143. (DEFMACRO SAFE-PRINT (PRINT-FORM)
  144.   ;;`(WITHOUT-INTERRUPTS (LET ((^W T)) ,PRINT-FORM))
  145.   ;; Still can't figure out what the ^W is bound for. - GJC
  146.   ;;    Answer: SAFE-PRINT is used when the user types <RETURN> to 
  147.   ;;    --More Display?-- but has a WRITEFILE open.  In that case,
  148.   ;;    you want to write out to the file but not to the TTY. - JPG
  149.   #+PDP10 `(LET ((^W T)) ,PRINT-FORM)
  150.   #-PDP10  PRINT-FORM)
  151.  
  152. (DEFMACRO LG-END-VECTOR (X Y) `(LG-DRAW-VECTOR ,X ,Y))
  153.  
  154.  
  155.  
  156.